home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmGridPrint.pas < prev    next >
Pascal/Delphi Source File  |  2002-01-04  |  9KB  |  278 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                            TGmGridPrint 2.3                                 }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.com                 }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.com                                }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmGridPrint;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  19.   GmPreview, GmTypes, grids;
  20.  
  21. const
  22.   TEXT_SPACE = 100;
  23.  
  24. type
  25.   TGmDrawCellEvent    = procedure (Sender: TObject; Col, Row: Longint; Rect: TRect; ACanvas: TGmCanvas) of object;
  26.   TGmGridNewPageEvent = procedure (Sender: TObject; var ATop: TGmValue) of object;
  27.  
  28.   TGmGridPrint = class(TComponent)
  29.   private
  30.     FMonochrome: Boolean;
  31.     FScale: Extended;
  32.     FScaleText: Boolean;
  33.     FPreview: TGmPreview;
  34.     FStringGrid: TStringGrid;
  35.     FOnDrawCell: TGmDrawCellEvent;
  36.     FOnGridNewPage: TGmGridNewPageEvent;
  37.     procedure DrawLeftTopBorder(ACanvas: TGmCanvas; ARect: TRect);
  38.     procedure DrawRightBorder(ACanvas: TGmCanvas; ARect: TRect);
  39.     procedure DrawBottomBorder(ACanvas: TGmCanvas; ARect: TRect);
  40.     { Private declarations }
  41.   protected
  42.     procedure DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; ACanvas: TGmCanvas); virtual;
  43.  
  44.     procedure GotoNextPage;
  45.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  46.  
  47.     function GetGridWidth: integer;
  48.     function GetCellRect(GridLeft, GridTop: Integer; ACol, ARow: integer; AScale: Extended): TRect;
  49.     { Protected declarations }
  50.   public
  51.     constructor Create(AOwner: TComponent); override;
  52.     procedure GridToPage(X, Y, AWidth: Extended; AUnits: TGmMeasurement;
  53.       AGrid: TStringGrid);
  54.     { Public declarations }
  55.   published
  56.     { Published declarations }
  57.     property Monochrome: Boolean read FMonochrome write FMonochrome default False;
  58.     property Preview: TGmPreview read FPreview write FPreview;
  59.     property ScaleText: Boolean read FScaleText write FScaleText default True;
  60.     // events...
  61.     property OnDrawCell: TGmDrawCellEvent read FOnDrawCell write FOnDrawCell;
  62.     property OnGridNewPage: TGmGridNewPageEvent read FOnGridNewPage write FOnGridNewPage;
  63.   end;
  64.  
  65. implementation
  66.  
  67. uses GmErrors, Dialogs;
  68.  
  69. constructor TGmGridPrint.Create(AOwner: TComponent);
  70. begin
  71.   inherited;
  72.   FMonochrome := False;
  73.   FScaleText := True;
  74. end;
  75.  
  76. procedure TGmGridPrint.Notification(AComponent: TComponent; Operation: TOperation);
  77. begin
  78.   inherited Notification(AComponent, Operation);
  79.   if (Operation = opRemove) and (AComponent = FPreview) then
  80.     FPreview := nil;
  81. end;
  82.  
  83. procedure TGmGridPrint.GotoNextPage;
  84. begin
  85.   if FPreview.CurrentPage < FPreview.NumPages then
  86.     FPreview.CurrentPage := FPreview.CurrentPage+1
  87.   else
  88.     FPreview.NewPage;
  89. end;
  90.  
  91. function TGmGridPrint.GetGridWidth: integer;
  92. var
  93.   ICountX: integer;
  94. begin
  95.   Result := 0;
  96.   for ICountX := 0 to FStringGrid.ColCount-1 do
  97.     Inc(Result, FStringGrid.ColWidths[ICountX]);
  98.   Result := Round(ConvertValue(Result, GmPixels, GmUnits));
  99. end;
  100.  
  101. function TGmGridPrint.GetCellRect(GridLeft, GridTop: Integer; ACol, ARow: integer; AScale: Extended): TRect;
  102. var
  103.   CellWidth, CellHeight: integer;
  104. begin
  105.   Result.Left := 0;
  106.   Result.Top := 0;
  107.  
  108.   CellWidth   :=  Round(ConvertValue(FStringGrid.ColWidths[ACol], GmPixels, GmUnits));
  109.   CellHeight  :=  Round(ConvertValue(FStringGrid.RowHeights[ARow], GmPixels, GmUnits));
  110.  
  111.   Result.Left   := GridLeft;
  112.   Result.Top    := GridTop;
  113.   Result.Right  := GridLeft + Round(CellWidth * AScale);
  114.   Result.Bottom := GridTop  + Round(CellHeight);
  115. end;
  116.  
  117. procedure TGmGridPrint.DrawLeftTopBorder(ACanvas: TGmCanvas; ARect: TRect);
  118. begin
  119.   with ACanvas do
  120.   begin
  121.     Pen.Color := clBlack;
  122.     MoveTo(ARect.Left, ARect.Bottom, GmUnits);
  123.     LineTo(ARect.Left, ARect.Top, GmUnits);
  124.     LineTo(ARect.Right, ARect.Top, GmUnits);
  125.   end;
  126. end;
  127.  
  128. procedure TGmGridPrint.DrawRightBorder(ACanvas: TGmCanvas; ARect: TRect);
  129. begin
  130.   with ACanvas do
  131.   begin
  132.     Pen.Color := clBlack;
  133.     MoveTo(ARect.Right, ARect.Bottom, GmUnits);
  134.     LineTo(ARect.Right, ARect.Top, GmUnits);
  135.   end;
  136. end;
  137.  
  138. procedure TGmGridPrint.DrawBottomBorder(ACanvas: TGmCanvas; ARect: TRect);
  139. begin
  140.   with ACanvas do
  141.   begin
  142.     Pen.Color := clBlack;
  143.     Line(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom, GmUnits);
  144.   end;
  145. end;
  146.  
  147. procedure TGmGridPrint.GridToPage(X, Y, AWidth: Extended; AUnits: TGmMeasurement;
  148.   AGrid: TStringGrid);
  149. var
  150.   GridLeft,GridTop: integer;
  151.   ICountX, ICountY: integer;
  152.   ARect: TRect;
  153.   PrintWidth: Extended;
  154.   CurrentYPos: Integer;
  155.   CurrentXPos: Integer;
  156.   YValue: TGmValue;
  157.   LastPen: TPen;
  158. begin
  159.   FStringGrid := AGrid;
  160.   if Assigned(FPreview) then
  161.   begin
  162.     LastPen := TPen.Create;
  163.     LastPen.Assign(FPreview.Canvas.Pen);
  164.     FPreview.MessagesEnabled := False;
  165.     // get the print scale...
  166.     if AWidth <> 0 then
  167.     begin
  168.       PrintWidth := Round(ConvertValue(AWidth, AUnits, GmUnits));
  169.       FScale := PrintWidth / GetGridWidth;
  170.     end
  171.     else
  172.       FScale := 1;
  173.     GridLeft  := Round(ConvertValue(X, AUnits, GmUnits));
  174.     GridTop   := Round(ConvertValue(Y, AUnits, GmUnits));
  175.  
  176.     CurrentYPos := GridTop;
  177.     CurrentXPos := GridLeft;
  178.     for ICountY := 0 to FStringGrid.RowCount-1 do
  179.     begin
  180.       for ICountX := 0 to FStringGrid.ColCount-1 do
  181.       begin
  182.         ARect := GetCellRect(CurrentXPos, CurrentYPos, ICountX, ICountY, FScale);
  183.         with FPreview.Canvas do
  184.         begin
  185.           DrawCell(Self, ICountX, ICountY, ARect, FPreview.Canvas);
  186.  
  187.           DrawLeftTopBorder(FPreview.Canvas, ARect);
  188.           if ICountX = FStringGrid.ColCount-1 then DrawRightBorder(FPreview.Canvas, ARect);
  189.  
  190.           if ICountY = FStringGrid.RowCount-1 then DrawBottomBorder(FPreview.Canvas, ARect);
  191.  
  192.         end;
  193.         Inc(CurrentXPos, ARect.Right-ARect.Left);
  194.         if ICountX = FStringGrid.ColCount-1 then CurrentXPos := GridLeft;
  195.       end;
  196.  
  197.       Inc(CurrentYPos, ARect.Bottom-ARect.Top);
  198.  
  199.       if CurrentYPos > (FPreview.PageHeight.AsUnits - (FPreview.Margins.Bottom.AsUnits + +FPreview.Header.Height.AsUnits + 1000)) then
  200.       begin
  201.         if ICountY < FStringGrid.RowCount-1 then
  202.         begin
  203.           DrawBottomBorder(FPreview.Canvas, Rect(GridLeft, ARect.Bottom, ARect.Right, ARect.Bottom));
  204.           GotoNextPage;
  205.           CurrentYPos := GridTop;
  206.           if Assigned(FOnGridNewPage) then
  207.           begin
  208.             YValue := TGmValue.Create;
  209.             FOnGridNewPage(Self, YValue);
  210.             if YValue.AsUnits <> 0 then CurrentYPos := YValue.AsUnits;
  211.             YValue.Free;
  212.           end;
  213.         end;
  214.       end;
  215.     end;
  216.     FPreview.Canvas.Pen.Assign(LastPen);
  217.     LastPen.Free;
  218.     FPreview.MessagesEnabled := True;
  219.     FPreview.UpdatePreview;
  220.   end
  221.   else
  222.     ShowGmError(Self, PREVIEW_NOT_ASSIGNED);
  223. end;
  224.  
  225. procedure TGmGridPrint.DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; ACanvas: TGmCanvas);
  226. var
  227.   LastPenColor: TColor;
  228.   LastPpi: integer;
  229. begin
  230.   LastPpi := ACanvas.Font.PixelsPerInch;
  231.   ACanvas.Font.Assign(FStringGrid.Font);
  232.   if Assigned(FOnDrawCell) then
  233.   with ACanvas do
  234.   begin
  235.     if (FScale < 1) and (FScaleText) then Font.PixelsPerInch := Round(Font.PixelsPerInch / FScale);
  236.     Pen.Style := psClear;
  237.     FOnDrawCell(Self, Col, Row, Rect, FPreview.Canvas);
  238.     Pen.Style := psSolid;
  239.     ACanvas.Font.PixelsPerInch := LastPpi;
  240.   end
  241.   else
  242.   begin
  243.     with ACanvas do
  244.     begin
  245.       if (Col <= FStringGrid.FixedCols-1) or (Row <= FStringGrid.FixedRows-1) then
  246.         ACanvas.Brush.Color := FStringGrid.FixedColor
  247.       else
  248.         ACanvas.Brush.Color := FStringGrid.Color;
  249.       LastPenColor := Pen.Color;
  250.       Pen.Color := Brush.Color;
  251.       if FMonochrome then
  252.       begin
  253.         Brush.Style := bsClear;
  254.         Pen.Style := psClear;
  255.       end;
  256.       Rectangle(Rect.Left,
  257.                 Rect.Top,
  258.                 Rect.Right,
  259.                 Rect.Bottom,
  260.                 GmUnits);
  261.       Pen.Color := LastPenColor;
  262.       Pen.Style := psClear;
  263.       if (FScale < 1) and (FScaleText) then Font.PixelsPerInch := Round(Font.PixelsPerInch / FScale);
  264.       TextBoxExt(Rect.Left+TEXT_SPACE,
  265.                  Rect.Top,
  266.                  Rect.Right,
  267.                  Rect.Bottom,
  268.                  FStringGrid.Cells[Col, Row], taLeftJustify, gmMiddle, True, GmUnits);
  269.       Font.PixelsPerInch := LastPpi;
  270.       Pen.Style := psSolid;
  271.       Brush.Style := bsSolid;
  272.     end;
  273.   end;
  274. end;
  275.  
  276.  
  277. end.
  278.